home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Technotools
/
Technotools (Chestnut CD-ROM)(1993).ISO
/
lang_pas
/
thelp4
/
thelp4.pas
< prev
Wrap
Pascal/Delphi Source File
|
1988-03-04
|
39KB
|
841 lines
{$R-} {Range checking off}
{$B+} {Boolean complete evaluation on}
{$S+} {Stack checking on}
{$I+} {I/O checking on}
{$N-} {No numeric coprocessor}
{$M 1024,0,3072}
{ Program THELP was originally written by a Mr. Glenn Wood of the Greenville PC Club of
Greenville, Texas. This updated version was reprogrammed by John Sloan, AlphaOmega
Computer Services, Devon, Alberta (CIS 71310,2267). It is entirely memory
resident and takes up about 46,944 K of memory space. It has been tested on
PCjr, PC CGA, EGA, PS2 VGA, MCGA. To keep the memory size down, many of the
original Procedure and Function help screens have been deleted. These, however,
are still available from the Turbo 4.0 editor using either <F1> or <ALT-F1>.
Thelp 4.0 now installs correctly on the PCjr and searches for any available
user interrupt between 60H and 67H. If it finds an available slot it will
install itself, otherwise it will abort with an error message. Thelp 4.0
will also detect whether it has already been installed or not. The window
routines have been borrowed from Eric Snyder's excellent Minigen vs 1.3
screen generator. This program uses Snyder's MGProg.TPU unit to compile.
}
PROGRAM THELP;
{ $C-}
{VARIABLE SECTION FOR 'THELP'}
Uses
Crt,
Dos,
MGProg;
const
EntryChar = 35; { ALT 'H' }
Escape = 0;
FirstRow = 3;
FirstCol = 11;
WindowWidth = 60;
WindowLength = 18;
Dr = 3;
Mr = 15;
Cr = $0D;
KybdInt = $16;
maxpage = 5; {maximum # of pages for each menu item}
Maxline = 68;
Type
text80 = string[80];
Str80 = string[80];
FldTyp = Record
Typ : Char;
Col,Row,Atr,Len : Byte;
Txt : Str80;
End;
ScreenArray = Array[1..Maxline] of Fldtyp;
var
UserInt : byte;
exitcode : word;
reg : Registers;
i,j,x,y : integer;
Selection : integer;
Vector1,
Vector2 : Pointer;
pagetop : array[1..maxpage] of byte;
page : byte;
Esc : boolean;
{ MISC. PROCEDURES AND FUNTIONS FOR THELP }
procedure Brite(line:text80);
begin
textcolor(15);
write(line);
textcolor(7);
end;
procedure PrintHeading;
begin
brite('T'); write('URBO Pascal ');
brite('Help '); write('Ver 4.0');
end;
{ MENU PRINT PROCEDURES FOR THELP }
procedure PrintMenu(number:integer);
begin
case number of
0 : begin
gotoxy(mr+4,2); PrintHeading;
gotoxy(mr+7,5); brite('MAIN MENU');
gotoxy(mr,6); write('<1> Syntax Structure');
gotoxy(mr,7); write('<2> Compiler Directives');
gotoxy(mr,8); write('<3> Fatal Runtime Errors');
gotoxy(mr,9); write('<4> I/O Errors and Dos Errors');
gotoxy(mr,10); write('<5> Reserved Words');
gotoxy(mr,11); write('<6> Keyboard Scan codes');
end;
1 : begin
gotoxy(mr+4,2); PrintHeading;
gotoxy(mr+6,5); brite('SYNTAX STRUCTURE MENU');
gotoxy(mr,6); write('<1> Types and Type Casting');
gotoxy(mr,7); write('<2> Constants and Typed Constants');
gotoxy(mr,8); write('<3> Variables');
gotoxy(mr,9); write('<4> Operators');
gotoxy(mr,10); write('<5> Program Structure');
gotoxy(mr,11); write('<6> Procedure and Function Structure');
gotoxy(mr,12); write('<7> Unit Structure');
gotoxy(mr,13); write('<8> Statements');
end;
end;{case}
repeat
gotoxy(14,18); Brite('Enter Selection or <ESC> to Exit ');
reg.ax := $00;
Intr(userint,reg);
selection:=reg.ah -1
until ((selection in [0..9]) and (number = 0))
or ((selection in [0..8]) and (number = 1));
clrscr;
end;
Procedure WriteScreen(Numfields:byte; Var FieldsArray);
Type
ScreenArray = Array[1..Maxline] of Fldtyp;{allows variable length arrays
to be passed in as an untyped
variable and then typecast to
this array type}
Var i,j,k:byte;
key :char;
procedure Pause(var key:char);
Var ch:char;
begin Case key of
'1':begin
gotoxy(22,18); brite('<PgDn>');write(' for next PAGE');
Repeat until Keypressed;
Repeat
ch:=Readkey;
if ord(ch) = 00 then
ch:=readkey;
if (ord(ch)= 81) or (ord(ch)=51) then key:='D';
Until ord(ch) in [51,81];
end;
'E':begin
gotoxy(12,18); brite('<PgUp> ');write('for previous page or ');brite('<Esc> for MENU');
Repeat until Keypressed;
Repeat
ch:=Readkey;
if ord(ch) = 00 then
ch:=readkey;
if (ord(ch)= 73) or (ord(ch)=57) then key:='U';
if (ord(ch)= 01) then key:='E';
Until ord(ch) in [57,73,$1B];
end;
'U','D':begin
gotoxy(12,18); brite('<PgUp> ');write('for previous page or ');brite('<PgDn>');
write(' for next PAGE');
Repeat until Keypressed;
Repeat
ch:=Readkey;
if ord(ch) = 00 then
ch:=readkey;
if (ord(ch)= 73) or (ord(ch)=57) then key:='U';
if (ord(ch)= 81) or (ord(ch)=51) then key:='D';
Until ord(ch) in [51,57,73,81];
end;
end;{case}
clrscr;
end; {Pause}
Begin {WriteScreen}
pagetop[1]:=1;
I:=1;
page:=1;
Esc:=False;
key:='1';
Repeat
With ScreenArray(FieldsArray)[I] do WinRite(Txt,Col,Row,Atr);
I:=I+1;
If (ScreenArray(Fieldsarray)[I].Row =1) or (I = Numfields +1) then
begin
If I = Numfields + 1 then key :='E';
Pause(key);
case key of
'U':If page <> 1 then
begin
I:=pagetop[page-1];
page:=page-1;
If page = 1 then
key:='1';
end;
{else
begin
I:=1;
key:='1';
end;}
'D':begin
page:=page+1;
pagetop[page]:=I
end;
'E':Esc:=True;
end;{Case}
end; {if}
Until Esc;
end; {WriteScreen}
procedure Wait;
begin
gotoxy(17,18); brite('Press <ESC> To Return to MENU');
repeat
reg.ax := 0;
Intr(userint,reg);
until reg.ah = $01;
clrscr;
end;
procedure PrintType;
Type
Str80 = string[80];
FldTyp = Record
Typ : Char;
Col,Row,Atr,Len : Byte;
Txt : Str80;
End;
Const
NumFields = 28;
FieldsArray : Array[1..Numfields] of Fldtyp =
(
(Typ:'T';Col:23;Row:1;Atr:31;Len:60;Txt:'TYPES (pg. 207)'),
(Typ:'T';Col:2;Row:2;Atr:31;Len:60;Txt:' Simple Type: (pg. 208)'),
(Typ:'T';Col:2;Row:3;Atr:23;Len:60;Txt:' days = 1..30; {Ordinal}'),
(Typ:'T';Col:2;Row:4;Atr:23;Len:60;Txt:' day = (monday,tuesday,wednesday,thursday,'),
(Typ:'T';Col:2;Row:5;Atr:23;Len:60;Txt:' friday,saturday,sunday); {Enumerated}'),
(Typ:'T';Col:2;Row:6;Atr:23;Len:60;Txt:' letter = ''a''..''z''); {subrange}'),
(Typ:'T';Col:2;Row:7;Atr:23;Len:60;Txt:' Hex = byte; {0..255}'),
(Typ:'T';Col:2;Row:8;Atr:23;Len:60;Txt:' Smallnum = shortint; {-128..127}'),
(Typ:'T';Col:2;Row:9;Atr:23;Len:60;Txt:' A/D_range = integer; {-32768..32767}'),
(Typ:'T';Col:2;Row:10;Atr:23;Len:60;Txt:' Address = word; {0..65535}'),
(Typ:'T';Col:2;Row:11;Atr:31;Len:60;Txt:' Boolean Type: (pg. 210)'),
(Typ:'T';Col:2;Row:12;Atr:23;Len:60;Txt:' Switch = boolean {False < True}'),
(Typ:'T';Col:2;Row:13;Atr:31;Len:60;Txt:' Char type: (pg. 210)'),
(Typ:'T';Col:2;Row:14;Atr:23;Len:60;Txt:' C = char {''A''..''Z'',''a''..''z'',''0''..''9''}'),
(Typ:'T';Col:23;Row:1;Atr:31;Len:60;Txt:'TYPES (con''t)'),
(Typ:'T';Col:2;Row:2;Atr:31;Len:60;Txt:' Real type: (pg. 212)'),
(Typ:'T';Col:2;Row:3;Atr:23;Len:60;Txt:' Distance = real; {2.9e-39..1.7e38 11..12 digits}'),
(Typ:'T';Col:2;Row:4;Atr:23;Len:60;Txt:' wavelength = single; {8087 only}'),
(Typ:'T';Col:2;Row:5;Atr:23;Len:60;Txt:' bignumber = double; {8087 only}'),
(Typ:'T';Col:2;Row:6;Atr:23;Len:60;Txt:' supernumber= extended; {8087 only}'),
(Typ:'T';Col:2;Row:7;Atr:23;Len:60;Txt:' Big_num = longint; {-2147483648..217483647}'),
(Typ:'T';Col:2;Row:8;Atr:31;Len:60;Txt:' String Type: (pg. 213)'),
(Typ:'T';Col:2;Row:9;Atr:23;Len:60;Txt:' text80 = STRING[80]; {1..255}'),
(Typ:'T';Col:2;Row:10;Atr:23;Len:60;Txt:' text_255 = STRING; {default}'),
(Typ:'T';Col:2;Row:11;Atr:31;Len:60;Txt:' Typecasting: (pg. 229)'),
(Typ:'T';Col:2;Row:12;Atr:23;Len:60;Txt:' Type P = word;'),
(Typ:'T';Col:2;Row:13;Atr:23;Len:60;Txt:' Var Q:integer;'),
(Typ:'T';Col:2;Row:14;Atr:23;Len:60;Txt:' Begin P :=word(Q) End. {variable typecast} ')
);
Begin
WriteScreen(Numfields,Fieldsarray);
end;
Procedure PrintConst;
Type
Str80 = string[80];
FldTyp = Record
Typ : Char;
Col,Row,Atr,Len : Byte;
Txt : Str80;
End;
Const
NumFields = 30;
FieldsArray : Array[1..Numfields] of Fldtyp =
(
(Typ:'T';Col:18;Row:1;Atr:31;Len:60;Txt:'Constants and Typed Constants '),
(Typ:'T';Col:2;Row:2;Atr:31;Len:60;Txt:' { integer, real, boolean, char, string[xx] }'),
(Typ:'T';Col:2;Row:3;Atr:23;Len:60;Txt:' Const {pg. 202}'),
(Typ:'T';Col:2;Row:4;Atr:23;Len:60;Txt:' minus2 = -2;'),
(Typ:'T';Col:2;Row:5;Atr:23;Len:60;Txt:' pagesize = 60;'),
(Typ:'T';Col:2;Row:6;Atr:23;Len:60;Txt:' pi = 3.1415926535;'),
(Typ:'T';Col:2;Row:7;Atr:23;Len:60;Txt:' histring = ''hello'';'),
(Typ:'T';Col:2;Row:8;Atr:23;Len:60;Txt:' valid = TRUE;'),
(Typ:'T';Col:20;Row:1;Atr:31;Len:60;Txt:'Typed Constants (pg. 231)'),
(Typ:'T';Col:2;Row:2;Atr:23;Len:60;Txt:' Const'),
(Typ:'T';Col:2;Row:3;Atr:23;Len:60;Txt:' Maximum : integer = 9999;'),
(Typ:'T';Col:2;Row:4;Atr:23;Len:60;Txt:' Breakchar : char = #3;'),
(Typ:'T';Col:2;Row:5;Atr:23;Len:60;Txt:' Heading : string[7] = ''Section'' '),
(Typ:'T';Col:2;Row:6;Atr:23;Len:60;Txt:' Newline : string[2] = #13#10;'),
(Typ:'T';Col:2;Row:7;Atr:23;Len:60;Txt:' Digits : array[0..3] of char = (''0123'')'),
(Typ:'T';Col:2;Row:8;Atr:23;Len:60;Txt:' Type'),
(Typ:'T';Col:2;Row:9;Atr:23;Len:60;Txt:' Cube = array[0..1,0..1,0..1] of integer;'),
(Typ:'T';Col:2;Row:10;Atr:23;Len:60;Txt:' Const'),
(Typ:'T';Col:2;Row:11;Atr:23;Len:60;Txt:' Maze: Cube = (((0,1),(2,3)),((4,5),(6,7)));'),
(Typ:'T';Col:20;Row:1;Atr:31;Len:60;Txt:'Typed Constants (con''t.)'),
(Typ:'T';Col:2;Row:2;Atr:23;Len:60;Txt:' Type'),
(Typ:'T';Col:2;Row:3;Atr:23;Len:60;Txt:' Point = record'),
(Typ:'T';Col:2;Row:4;Atr:23;Len:60;Txt:' x,y: real;'),
(Typ:'T';Col:2;Row:5;Atr:23;Len:60;Txt:' end;'),
(Typ:'T';Col:2;Row:6;Atr:23;Len:60;Txt:' Const'),
(Typ:'T';Col:2;Row:7;Atr:23;Len:60;Txt:' Origon : Point = (x: 0.0; y: 0.0);'),
(Typ:'T';Col:2;Row:8;Atr:23;Len:60;Txt:' Type'),
(Typ:'T';Col:2;Row:9;Atr:23;Len:60;Txt:' Letters = set of ''A''..''Z'';'),
(Typ:'T';Col:2;Row:10;Atr:23;Len:60;Txt:' Const'),
(Typ:'T';Col:2;Row:11;Atr:23;Len:60;Txt:' Vowels : = [''A'',''E'',''I'',''O'',''U'',''Y''];')
);
Begin
WriteScreen(Numfields,Fieldsarray);
end;
Procedure PrintVar;
begin
gotoxy(dr+18,2);brite('Variables: (pg. 223)');
gotoxy(dr,3); write(' {integer, real, boolean, char, string[xx] }');
gotoxy(dr,4); write(' VAR');
gotoxy(dr,5); write(' count,index : Integer;');
gotoxy(dr,6); write(' result,value : Real;');
gotoxy(dr,7); write(' eom,character : Char;');
gotoxy(dr,8); write(' line : String[80];');
gotoxy(dr,9); write(' error : Boolean;');
gotoxy(dr,10); write(' inventory : File of invtype;');
gotoxy(dr,11); write(' matrix : Array [1..50,1..50] of Integer;');
gotoxy(dr,12); write(' cmdlength : Byte Absolute Prefixseg:$0080;');
gotoxy(dr,13); write(' cmdline : String[127] Absolute Prefixseg:$0080;');
gotoxy(dr,14); write(' intrip : Integer Absolute $0000:$0040;');
Wait;
end;
Procedure operator1;
{ MiniGen V1.3 }
Type
Str80 = String[80];
FldTyp = Record
Typ : Char;
Col,Row,Atr,Len : Byte;
Txt : Str80;
End;
Const
NumFields = 50;
FieldsArray : Array[1..Numfields] of Fldtyp =
(
(Typ:'T';Col:2;Row:1;Atr:31;Len:60;Txt:' Operators (pg. 241)'),
(Typ:'T';Col:2;Row:2;Atr:31;Len:60;Txt:' Operators Operation Operand Types Result Type'),
(Typ:'T';Col:2;Row:3;Atr:23;Len:60;Txt:' + addition integer type integer type'),
(Typ:'T';Col:2;Row:4;Atr:23;Len:60;Txt:' real type real type '),
(Typ:'T';Col:2;Row:5;Atr:23;Len:60;Txt:' - subtraction integer typ integer type'),
(Typ:'T';Col:2;Row:6;Atr:23;Len:60;Txt:' real type real type'),
(Typ:'T';Col:2;Row:7;Atr:23;Len:60;Txt:' * multiplication integer type integer type'),
(Typ:'T';Col:2;Row:8;Atr:23;Len:60;Txt:' real type real type'),
(Typ:'T';Col:2;Row:9;Atr:23;Len:60;Txt:' / division integer type real type'),
(Typ:'T';Col:2;Row:10;Atr:23;Len:60;Txt:' real type real type'),
(Typ:'T';Col:2;Row:11;Atr:23;Len:60;Txt:' div int. division integer type integer type'),
(Typ:'T';Col:2;Row:12;Atr:23;Len:60;Txt:' mod remainder integer type integer type'),
(Typ:'T';Col:2;Row:13;Atr:23;Len:60;Txt:' + sign identity integer type integer type'),
(Typ:'T';Col:2;Row:14;Atr:23;Len:60;Txt:' real type real type'),
(Typ:'T';Col:2;Row:15;Atr:23;Len:60;Txt:' - sign negation integer type integer type'),
(Typ:'T';Col:2;Row:16;Atr:23;Len:60;Txt:' real type real type'),
(Typ:'T';Col:2;Row:1;Atr:31;Len:60;Txt:' Logical Operators (pg. 242)'),
(Typ:'T';Col:3;Row:2;Atr:31;Len:60;Txt:' Operator Operation Operand Types Result type'),
(Typ:'T';Col:2;Row:3;Atr:23;Len:60;Txt:' not Bit negation integer type integer type'),
(Typ:'T';Col:2;Row:4;Atr:23;Len:60;Txt:' and Bit and integer type integer type'),
(Typ:'T';Col:2;Row:5;Atr:23;Len:60;Txt:' or Bit or integer type integer type'),
(Typ:'T';Col:2;Row:6;Atr:23;Len:60;Txt:' xor Bit xor integer type integer type'),
(Typ:'T';Col:2;Row:7;Atr:23;Len:60;Txt:' shl Shift left integer type integer type'),
(Typ:'T';Col:2;Row:8;Atr:23;Len:60;Txt:' shr Shift right integer type integer type'),
(Typ:'T';Col:2;Row:9;Atr:23;Len:60;Txt:' not negation boolean boolean'),
(Typ:'T';Col:2;Row:10;Atr:23;Len:60;Txt:' and logical and boolean boolean'),
(Typ:'T';Col:2;Row:11;Atr:23;Len:60;Txt:' or logical or boolean boolean'),
(Typ:'T';Col:2;Row:12;Atr:23;Len:60;Txt:' xor logical xor boolean boolean'),
(Typ:'T';Col:2;Row:13;Atr:23;Len:60;Txt:' + Concatenation string,char string type'),
(Typ:'T';Col:2;Row:14;Atr:23;Len:60;Txt:' or packed string types'),
(Typ:'T';Col:2;Row:15;Atr:23;Len:60;Txt:' + union compatible set types'),
(Typ:'T';Col:2;Row:16;Atr:23;Len:60;Txt:' - difference compatible set types'),
(Typ:'T';Col:2;Row:17;Atr:23;Len:60;Txt:' * intersection compatible set types'),
(Typ:'T';Col:20;Row:1;Atr:31;Len:41;Txt:' Relational Operators (pg. 246)'),
(Typ:'T';Col:3;Row:2;Atr:31;Len:60;Txt:' Operator Operation Operand Types Result type'),
(Typ:'T';Col:2;Row:3;Atr:23;Len:60;Txt:' = equal simple pointer boolean '),
(Typ:'T';Col:2;Row:4;Atr:23;Len:60;Txt:' pointer,set,'),
(Typ:'T';Col:2;Row:5;Atr:23;Len:60;Txt:' string or packed string'),
(Typ:'T';Col:2;Row:6;Atr:23;Len:60;Txt:' <> not equal same as above boolean'),
(Typ:'T';Col:2;Row:7;Atr:23;Len:60;Txt:' < not equal same as above boolean'),
(Typ:'T';Col:2;Row:8;Atr:23;Len:60;Txt:' > greater than same as above boolean'),
(Typ:'T';Col:2;Row:9;Atr:23;Len:60;Txt:' <= less or equal same as above boolean'),
(Typ:'T';Col:2;Row:10;Atr:23;Len:60;Txt:' >= great or equal same as above boolean'),
(Typ:'T';Col:2;Row:11;Atr:23;Len:60;Txt:' <= subset of compatible sets boolean'),
(Typ:'T';Col:2;Row:12;Atr:23;Len:60;Txt:' >= superset of compatible sets boolean'),
(Typ:'T';Col:2;Row:13;Atr:23;Len:60;Txt:' in member of left operand:any boolean'),
(Typ:'T';Col:2;Row:14;Atr:23;Len:60;Txt:' ordinal type t;'),
(Typ:'T';Col:2;Row:15;Atr:23;Len:60;Txt:' right operand'),
(Typ:'T';Col:2;Row:16;Atr:23;Len:60;Txt:' set whose base is'),
(Typ:'T';Col:2;Row:17;Atr:23;Len:60;Txt:' compatible with t.') );
Begin
WriteScreen(Numfields,Fieldsarray);
end;
procedure ProgramStructure;
begin
gotoxy(dr+15,1); brite('Program Structure: (pg 57)');
gotoxy(dr,2); write(' Program ProgramName;');
gotoxy(dr,3); write(' Label');
gotoxy(dr,4); write(' {labels};');
gotoxy(dr,5); write(' Const');
gotoxy(dr,6); write(' {constant declarations};');
gotoxy(dr,7); write(' Type');
gotoxy(dr,8); write(' {data type declarations};');
gotoxy(dr,9); write(' Var');
gotoxy(dr,10); write(' {variable declarations};');
gotoxy(dr,11); write(' {procedures}');
gotoxy(dr,12); write(' Procedure ProcedureName(parameters);');
gotoxy(dr,13); write(' {functions}');
gotoxy(dr,14); write(' Function FunctionName(parameters):data type;');
gotoxy(dr,15); write(' begin {main program body}');
gotoxy(dr,16); write(' {statements};');
gotoxy(dr,17); write(' end. {main program}');
Wait;
end;
Procedure ProcFunc_Structure;
begin
gotoxy(2,1); brite(' Procedure and Function Structure (pg. 57)');
gotoxy(2,2); write(' ProcName(Var num1,num2 : Integer; ch : Char)');
gotoxy(2,3); write(' Interrupt; {stacks registers if used as ISR, pg. 369}');
gotoxy(2,4); write(' Label');
gotoxy(2,5); write(' {labels};');
gotoxy(2,6); write(' Const');
gotoxy(2,7); write(' {constant declarations};');
gotoxy(2,8); write(' Type');
gotoxy(2,9); write(' {data type definitions};');
gotoxy(2,10); write(' Var');
gotoxy(2,11); write(' {variable declarations};');
gotoxy(2,12); write(' {local procedure and function declarations};');
gotoxy(2,13); write(' Begin {main body of procedure}');
gotoxy(2,14); write(' {statements};');
gotoxy(2,15); write(' End;');
gotoxy(2,16); write(' Function FunctionName(parameters):data_type;');
gotoxy(2,17); write(' {structure same as above}');
wait;
end;
Procedure Unit_structure;
begin
gotoxy(dr+15,1); brite('Unit Structure: (pg 61)');
gotoxy(dr,2); write(' Unit UnitName;');
gotoxy(dr,3); write(' Interface');
gotoxy(dr,4); write(' Uses {list all units that are used by this one}');
gotoxy(dr,5); write(' {Declare all constants, data types, variables,}');
gotoxy(dr,6); write(' { procedure and function headers (not body) } ');
gotoxy(dr,7); write(' { that will be accessible by any program. }');
gotoxy(dr,8); write(' Implementation');
gotoxy(dr,9); write(' {Private declarations and }');
gotoxy(dr,10); write(' {procedure and function headers and bodies}');
gotoxy(dr,11); write(' {declared in Interface section }');
gotoxy(dr,12); write(' End. {not used if next initialization section used}');
gotoxy(dr,13); write(' Begin');
gotoxy(dr,14); write(' {Used to initialize any data structures etc.}');
gotoxy(dr,15); write(' {used by this unit. It is called before }');
gotoxy(dr,16); write(' {main body of program using this unit is run}');
gotoxy(dr,17); write(' End. {of unit}');
Wait;
end;
Procedure Statements;
{ MiniGen V1.3 }
Type
Str80 = String[80];
FldTyp = Record Typ : Char;
Col,Row,Atr,Len : Byte;
Txt : Str80;
End;
Const
NumFields = 43;
FieldsArray : Array[1..Numfields] of Fldtyp =
(
(Typ:'T';Col:6;Row:1;Atr:31;Len:57;Txt:' Statement Syntax (pg. 253)'),
(Typ:'T';Col:6;Row:2;Atr:31;Len:57;Txt:'Assignment Statements:'),
(Typ:'T';Col:6;Row:3;Atr:23;Len:57;Txt:' X := Y + Z;'),
(Typ:'T';Col:6;Row:4;Atr:23;Len:57;Txt:' Done := (I > 1) and (I < 100);'),
(Typ:'T';Col:6;Row:5;Atr:31;Len:57;Txt:'Procedure Statements:'),
(Typ:'T';Col:6;Row:6;Atr:23;Len:57;Txt:' PrintHeading;'),
(Typ:'T';Col:6;Row:7;Atr:23;Len:57;Txt:' Fine(Name, Address);'),
(Typ:'T';Col:6;Row:8;Atr:31;Len:57;Txt:'Goto Statement:'),
(Typ:'T';Col:6;Row:9;Atr:23;Len:57;Txt:' 10 Goto 10; {forever loop}'),
(Typ:'T';Col:6;Row:10;Atr:31;Len:57;Txt:'Structure Statements:'),
(Typ:'T';Col:6;Row:11;Atr:31;Len:57;Txt:' Compound:'),
(Typ:'T';Col:6;Row:12;Atr:23;Len:57;Txt:' begin'),
(Typ:'T';Col:6;Row:13;Atr:23;Len:57;Txt:' Z := X;'),
(Typ:'T';Col:6;Row:14;Atr:23;Len:57;Txt:' X := Y;'),
(Typ:'T';Col:6;Row:15;Atr:23;Len:57;Txt:' end;'),
(Typ:'T';Col:6;Row:1;Atr:31;Len:57;Txt:' Statement Syntax (con''t)'),
(Typ:'T';Col:6;Row:2;Atr:31;Len:57;Txt:' Conditional:'),
(Typ:'T';Col:6;Row:3;Atr:23;Len:57;Txt:' If x < 1.5 then'),
(Typ:'T';Col:6;Row:4;Atr:23;Len:57;Txt:' Z := X + Y'),
(Typ:'T';Col:6;Row:5;Atr:23;Len:57;Txt:' else'),
(Typ:'T';Col:6;Row:6;Atr:23;Len:57;Txt:' Z := 1.5;'),
(Typ:'T';Col:6;Row:7;Atr:31;Len:57;Txt:' Case:'),
(Typ:'T';Col:6;Row:8;Atr:23;Len:57;Txt:' case Operator of'),
(Typ:'T';Col:6;Row:9;Atr:23;Len:57;Txt:' plus : X := X+Y;'),
(Typ:'T';Col:6;Row:10;Atr:23;Len:57;Txt:' Minus: X := X-Y;'),
(Typ:'T';Col:6;Row:11;Atr:23;Len:57;Txt:' else ...'),
(Typ:'T';Col:6;Row:12;Atr:31;Len:57;Txt:'Repeat Statements:'),
(Typ:'T';Col:6;Row:13;Atr:23;Len:57;Txt:' Repeat'),
(Typ:'T';Col:6;Row:14;Atr:23;Len:57;Txt:' Count := Count + 1;'),
(Typ:'T';Col:6;Row:15;Atr:23;Len:57;Txt:' Until Count >= 40;'),
(Typ:'T';Col:6;Row:16;Atr:23;Len:57;Txt:' While Count > 0 do '),
(Typ:'T';Col:6;Row:17;Atr:23;Len:57;Txt:' Writeln(''Count is '',Count);'),
(Typ:'T';Col:6;Row:1;Atr:31;Len:57;Txt:' Statement Syntax (con''t)'),
(Typ:'T';Col:6;Row:2;Atr:23;Len:57;Txt:' For Count = 0 to 40 do'),
(Typ:'T';Col:6;Row:3;Atr:23;Len:57;Txt:' begin'),
(Typ:'T';Col:6;Row:4;Atr:23;Len:57;Txt:' If Keypressed then ch:=Readkey;'),
(Typ:'T';Col:6;Row:5;Atr:23;Len:57;Txt:' If ch in [''A'',''a''] then InputOK:=True;'),
(Typ:'T';Col:6;Row:6;Atr:23;Len:57;Txt:' end; {for}'),
(Typ:'T';Col:6;Row:7;Atr:31;Len:57;Txt:'With Statement:'),
(Typ:'T';Col:6;Row:8;Atr:23;Len:57;Txt:' Var reg : registers; {predeclared record type}'),
(Typ:'T';Col:6;Row:9;Atr:23;Len:57;Txt:' ...'),
(Typ:'T';Col:6;Row:10;Atr:23;Len:57;Txt:' with reg do'),
(Typ:'T';Col:6;Row:11;Atr:23;Len:57;Txt:' if ax = $8000 then Busy := True;')
);
Begin
WriteScreen(Numfields,Fieldsarray);
end;
procedure PrintDirectives;
begin
gotoxy(dr,1); Brite(' COMPILER DIRECTIVES page Default');
gotoxy(dr,2); write(' B - Boolean Evaluation (528) $B- ');
gotoxy(dr,3); write(' D - debug info. On/off (529) $D+ ');
gotoxy(dr,4); write(' F - Force Far calls (529) $F- ');
gotoxy(dr,5); write(' I - I/O checking On/off (530) $I+ ');
gotoxy(dr,6); write(' L - memory linking On/off (530) $L+ ');
gotoxy(dr,7); write(' N - 8087 float.point On/off (530) $N- ');
gotoxy(dr,8); write(' R - Range Checking On/off (531) $R- ');
gotoxy(dr,9); write(' S - Stack Over. Chk. On/off (531) $S+ ');
gotoxy(dr,10); write(' T - TPM. file On/off (532) $T- ');
gotoxy(dr,11); write(' V - String type check On/off(532) $V+ ');
gotoxy(dr,12); write(' $I filename - include file (533) ');
gotoxy(dr,13); write(' $l filename - link file (533) ');
gotoxy(dr,14); write(' $M stacksize,heapmin,heapmax(534) ');
gotoxy(dr,15); write(' $U filename (534) ');
Wait;
end;
procedure RuntimeErrors;
begin
gotoxy(dr,1); Brite(' FATAL RUN-TIME ERROR MESSAGES : (pg. 629)');
gotoxy(dr,3); write(' 200 - Division by zero');
gotoxy(dr,4); write(' 201 - Range check error');
gotoxy(dr,5); write(' 202 - Stack overflow error');
gotoxy(dr,6); write(' 203 - Heap overflow error');
gotoxy(dr,7); write(' 204 - Invalid pointer operation');
gotoxy(dr,8); write(' 205 - Floating point overflow');
gotoxy(dr,9); write(' 206 - Floating point underflow');
gotoxy(dr,10); write(' 207 - Invalid floating point operation');
Wait;
end;
procedure IOErrors;
Type
Str80 = String[80];
FldTyp = Record
Typ : Char;
Col,Row,Atr,Len : Byte;
Txt : Str80;
End;
Const
NumFields = 26;
FieldsArray : Array[1..Numfields] of Fldtyp =
(
(Typ:'T';Col:6;Row:1;Atr:31;Len:57;Txt:' I/O ERROR MESSAGES : (pg. 626) '),
(Typ:'T';Col:6;Row:2;Atr:23;Len:57;Txt:' 02 - File not found.'),
(Typ:'T';Col:6;Row:3;Atr:23;Len:57;Txt:' 03 - Path not fount.'),
(Typ:'T';Col:6;Row:4;Atr:23;Len:57;Txt:' 04 - Too many open files.'),
(Typ:'T';Col:6;Row:5;Atr:23;Len:57;Txt:' 05 - File access denied.'),
(Typ:'T';Col:6;Row:6;Atr:23;Len:57;Txt:' 06 - Invalid file handle.'),
(Typ:'T';Col:6;Row:7;Atr:23;Len:57;Txt:' 12 - Invalid file access code.'),
(Typ:'T';Col:6;Row:8;Atr:23;Len:57;Txt:' 15 - Invalid drive number.'),
(Typ:'T';Col:6;Row:9;Atr:23;Len:57;Txt:' 16 - Cannot remove current directory.'),
(Typ:'T';Col:6;Row:10;Atr:23;Len:57;Txt:' 100 - Disk read error.'),
(Typ:'T';Col:6;Row:11;Atr:23;Len:57;Txt:' 101 - Disk write error'),
(Typ:'T';Col:6;Row:12;Atr:23;Len:57;Txt:' 102 - File not assigned'),
(Typ:'T';Col:6;Row:13;Atr:23;Len:57;Txt:' 103 - File not open'),
(Typ:'T';Col:6;Row:14;Atr:23;Len:57;Txt:' 104 - File not found for input'),
(Typ:'T';Col:6;Row:15;Atr:23;Len:57;Txt:' 105 - File not open for output'),
(Typ:'T';Col:6;Row:16;Atr:23;Len:57;Txt:' 106 - Invalid numeric format'),
(Typ:'T';Col:6;Row:1;Atr:31;Len:57;Txt:' DOS error codes (pg. 300)'),
(Typ:'T';Col:6;Row:2;Atr:23;Len:57;Txt:'{returned in integer variable DosError in DOS unit}'),
(Typ:'T';Col:6;Row:3;Atr:23;Len:57;Txt:' 2 - File not found'),
(Typ:'T';Col:6;Row:4;Atr:23;Len:57;Txt:' 3 - Path not found'),
(Typ:'T';Col:6;Row:5;Atr:23;Len:57;Txt:' 5 - Acess denied'),
(Typ:'T';Col:6;Row:6;Atr:23;Len:57;Txt:' 6 - Invalid Handle'),
(Typ:'T';Col:6;Row:7;Atr:23;Len:57;Txt:' 8 - Not enough memory'),
(Typ:'T';Col:6;Row:8;Atr:23;Len:57;Txt:' 10 - Invalid environment'),
(Typ:'T';Col:6;Row:9;Atr:23;Len:57;Txt:' 11 - Invalid format'),
(Typ:'T';Col:6;Row:10;Atr:23;Len:57;Txt:' 18 - No more files')
);
Var i,j,k:byte;
key :char;
Begin
WriteScreen(Numfields,Fieldsarray);
end;
Procedure Reserved_words;
begin
gotoxy(6,1); brite(' Reserved Word List (pg. 196)');
gotoxy(6,2); write('absolute goto record');
gotoxy(6,3); write('and if repeat');
gotoxy(6,4); write('array implementation set');
gotoxy(6,5); write('begin in shl');
gotoxy(6,6); write('case inline shr');
gotoxy(6,7); write('const interface string');
gotoxy(6,8); write('div interrupt then');
gotoxy(6,9); write('do label to');
gotoxy(6,10); write('downto mod type');
gotoxy(6,11); write('else nil unit');
gotoxy(6,12); write('end not until');
gotoxy(6,13); write('external of uses');
gotoxy(6,14); write('file or var');
gotoxy(6,15); write('for packed while');
gotoxy(6,16); write('forward procedure with');
gotoxy(6,17); write('function program xor');
wait;
End; {Reserved_words}
Procedure Key_Scan_Codes;
{ MiniGen V1.3 }
Type
Str80 = String[80];
FldTyp = Record
Typ : Char;
Col,Row,Atr,Len : Byte;
Txt : Str80;
End;
Const
NumFields = 68;
FieldsArray : Array[1..Numfields] of Fldtyp =
(
(Typ:'T';Col:6;Row:1;Atr:31;Len:57;Txt:' Keyboard Scan Codes (pg. 572)'),
(Typ:'T';Col:6;Row:2;Atr:31;Len:57;Txt:'Key Code(Hex) Key Code(Hex) Key Code(Hex)'),
(Typ:'T';Col:6;Row:3;Atr:23;Len:57;Txt:'Esc 01 A 1E F1 3B'),
(Typ:'T';Col:6;Row:4;Atr:23;Len:57;Txt:'!1 02 S 1F F2 3C'),
(Typ:'T';Col:6;Row:5;Atr:23;Len:57;Txt:'@2 03 D 20 F3 3D'),
(Typ:'T';Col:6;Row:6;Atr:23;Len:57;Txt:'#3 04 F 21 F4 3E'),
(Typ:'T';Col:6;Row:7;Atr:23;Len:57;Txt:'$4 05 G 22 F5 3F'),
(Typ:'T';Col:6;Row:8;Atr:23;Len:57;Txt:'%5 06 H 23 F6 40'),
(Typ:'T';Col:6;Row:9;Atr:23;Len:57;Txt:'^6 07 J 24 F7 41'),
(Typ:'T';Col:6;Row:10;Atr:23;Len:57;Txt:'&7 08 K 25 F8 42'),
(Typ:'T';Col:6;Row:11;Atr:23;Len:57;Txt:'*8 09 L 26 F9 43'),
(Typ:'T';Col:6;Row:12;Atr:23;Len:57;Txt:'(9 0A :; 27 F10 44'),
(Typ:'T';Col:6;Row:13;Atr:23;Len:57;Txt:')0 0B "'' 28 F11 D9'),
(Typ:'T';Col:6;Row:14;Atr:23;Len:57;Txt:'_- 0C ~` 29 F12 DA'),
(Typ:'T';Col:6;Row:15;Atr:23;Len:57;Txt:'+= 0D Leftshift 2A Scrlllck 46'),
(Typ:'T';Col:6;Row:16;Atr:23;Len:57;Txt:'Backspace 0E Spacebar 39 Lt/RtArr 0F'),
(Typ:'T';Col:6;Row:17;Atr:23;Len:57;Txt:'CTRL 1D Caps Lock 3A Q 10'),
(Typ:'T';Col:6;Row:1;Atr:31;Len:57;Txt:' Keyboard Scan Codes (con''t)'),
(Typ:'T';Col:6;Row:2;Atr:31;Len:57;Txt:'Key Code(Hex) Key Code(Hex) Key Code(hex)'),
(Typ:'T';Col:6;Row:3;Atr:23;Len:57;Txt:'W 11 C 2E 4LftArr 4B'),
(Typ:'T';Col:6;Row:4;Atr:23;Len:57;Txt:'E 12 V 2F 5 4C'),
(Typ:'T';Col:6;Row:5;Atr:23;Len:57;Txt:'R 13 B 30 6RtArr 4D'),
(Typ:'T';Col:6;Row:6;Atr:23;Len:57;Txt:'T 14 N 31 + 4E'),
(Typ:'T';Col:6;Row:7;Atr:23;Len:57;Txt:'Y 15 M 32 1End 4F'),
(Typ:'T';Col:6;Row:8;Atr:23;Len:57;Txt:'U 16 <, 33 2DwnArr 50'),
(Typ:'T';Col:6;Row:9;Atr:23;Len:57;Txt:'I 17 >. 34 3PgDn 51'),
(Typ:'T';Col:6;Row:10;Atr:23;Len:57;Txt:'O 18 ?/ 35 0Ins 52'),
(Typ:'T';Col:6;Row:11;Atr:23;Len:57;Txt:'P 19 Rtshift 36 Del 53'),
(Typ:'T';Col:6;Row:12;Atr:23;Len:57;Txt:'{[ 1A Prtscr* 37 NumLock 45'),
(Typ:'T';Col:6;Row:13;Atr:23;Len:57;Txt:'}] 1B Alt 38'),
(Typ:'T';Col:6;Row:14;Atr:23;Len:57;Txt:'Return 1C 7Home 47'),
(Typ:'T';Col:6;Row:15;Atr:23;Len:57;Txt:'|\ 2B 8UpArrw 48'),
(Typ:'T';Col:6;Row:16;Atr:23;Len:57;Txt:'Z 2C 9PgUp 49'),
(Typ:'T';Col:6;Row:17;Atr:23;Len:57;Txt:'X 2D Minussgn 4A'),
(Typ:'T';Col:6;Row:1;Atr:31;Len:57;Txt:' Extended Scan Codes (first code=Null pg. 571)'),
(Typ:'T';Col:6;Row:2;Atr:31;Len:57;Txt:'2ndCode(dec.) Meaning'),
(Typ:'T';Col:6;Row:3;Atr:23;Len:57;Txt:'3 NUL(null character'),
(Typ:'T';Col:6;Row:4;Atr:23;Len:57;Txt:'15 Shift Tab'),
(Typ:'T';Col:6;Row:5;Atr:23;Len:57;Txt:'16-25 Alt-Q/W/E/R/T/Y/U/I/O/P'),
(Typ:'T';Col:6;Row:6;Atr:23;Len:57;Txt:'30-38 Alt-A/S/D/F/G/H/I/J/K/L'),
(Typ:'T';Col:6;Row:7;Atr:23;Len:57;Txt:'44-50 Alt-Z/X/C/V/B/N/M'),
(Typ:'T';Col:6;Row:8;Atr:23;Len:57;Txt:'71 Home'),
(Typ:'T';Col:6;Row:9;Atr:23;Len:57;Txt:'72 Up Arrow'),
(Typ:'T';Col:6;Row:10;Atr:23;Len:57;Txt:'73 PgUp'),
(Typ:'T';Col:6;Row:11;Atr:23;Len:57;Txt:'75 Left Arrow'),
(Typ:'T';Col:6;Row:12;Atr:23;Len:57;Txt:'77 Right Arrow'),
(Typ:'T';Col:6;Row:13;Atr:23;Len:57;Txt:'79 End'),
(Typ:'T';Col:6;Row:14;Atr:23;Len:57;Txt:'80 Down Arrow'),
(Typ:'T';Col:6;Row:15;Atr:23;Len:57;Txt:'81 PgDn'),
(Typ:'T';Col:6;Row:16;Atr:23;Len:57;Txt:'82 Ins'),
(Typ:'T';Col:6;Row:17;Atr:23;Len:57;Txt:'83 Del'),
(Typ:'T';Col:6;Row:1;Atr:31;Len:57;Txt:' Extended Scan Codes (con''t)'),
(Typ:'T';Col:6;Row:2;Atr:31;Len:57;Txt:'2ndCode(dec.) Meaning'),
(Typ:'T';Col:6;Row:3;Atr:23;Len:57;Txt:'84-93 F11-F20 (Shift-F1 to Shift-F10)'),
(Typ:'T';Col:6;Row:4;Atr:23;Len:57;Txt:'94-103 F21-F30 (Ctrl-F1 through F10)'),
(Typ:'T';Col:6;Row:5;Atr:23;Len:57;Txt:'104-113 F31-F40 (Alt-F1 through F10)'),
(Typ:'T';Col:6;Row:6;Atr:23;Len:57;Txt:'114 Ctrl-PrtSc'),
(Typ:'T';Col:6;Row:7;Atr:23;Len:57;Txt:'115 Ctrl-left Arrow'),
(Typ:'T';Col:6;Row:8;Atr:23;Len:57;Txt:'116 Ctrl-Right Arrow'),
(Typ:'T';Col:6;Row:9;Atr:23;Len:57;Txt:'117 Ctrl-End'),
(Typ:'T';Col:6;Row:10;Atr:23;Len:57;Txt:'118 Ctrl-PgDn'),
(Typ:'T';Col:6;Row:11;Atr:23;Len:57;Txt:'119 Ctrl-Home'),
(Typ:'T';Col:6;Row:12;Atr:23;Len:57;Txt:'120-131 Alt-1/2/3/4/5/6/7/8/9/0/-/='),
(Typ:'T';Col:6;Row:13;Atr:23;Len:57;Txt:'132 Ctrl-PgUp'),
(Typ:'T';Col:6;Row:14;Atr:23;Len:57;Txt:'133 Shift-F11 +-> 137 Ctrl-F11'),
(Typ:'T';Col:6;Row:15;Atr:23;Len:57;Txt:'134 F12 | 138 Ctrl-F12'),
(Typ:'T';Col:6;Row:16;Atr:23;Len:57;Txt:'135 Shift-F11 | 139 Alt-F11'),
(Typ:'T';Col:6;Row:17;Atr:23;Len:57;Txt:'136 Shift-F12 --+ 140 Alt-F12')
);
Begin
WriteScreen(Numfields,Fieldsarray);
end;
{ MAIN INTERUPT SERVICE PROCEDURES }
procedure Syntax;
begin
repeat
PrintMenu(1);
case selection of
1 : PrintType;
2 : PrintConst; 3 : PrintVar;
4 : Operator1;
5 : ProgramStructure;
6 : ProcFunc_Structure;
7 : Unit_structure;
8 : Statements;
end;
until selection = escape;
selection := 10;
end;
procedure DOIT;
begin
textcolor(7);
repeat
PrintMenu(0);
case selection of
1 : Syntax;
2 : PrintDirectives;
3 : RuntimeErrors;
4 : IOErrors;
5 : Reserved_words;
6 : Key_Scan_Codes;
end;
until selection = escape;
end;
procedure ProcessInt(Flags,cs,ip,ax,bx,cx,dx,si,di,ds,es,bp:word);{ Start of interupt service }
Interrupt;
begin
Reg.ax:=ax;
If Reg.ah <> 0 then
Begin
Intr(UserInt,reg);
ax:=reg.ax;
Flags:=reg.flags
end
else
begin
Intr(UserInt,reg);
ax:=reg.ax;
Flags:=reg.flags;
if (reg.ah = EntryChar) and (reg.al = $00) then
begin
reg.ax := $0300;
reg.bx := $0;
DefineScreen(1,10,3,72,22,1,2,$70);
OpenWindow(1);
DOIT;
CloseWindow; { put back the text in the window }
TerminateScreens;
end;
end;
end;
{ PROGRAM 'THELP' } { Program installation }
Var Signature:^longint;
begin
userint:=$60; {start checking at first user int}
Repeat
GetIntVec(userint,Vector1);
GetIntVec(Kybdint,Vector2);
Signature:=Vector2;
If Signature^ = $52515350 then {use push instructions at beginning of}
Begin {ProcessInt as signature to detect if it}
Brite('THELP already Installed!'); {has already been loaded.}
exitcode:=3; {signal exit}
writeln;
End
Else
If (Meml[Seg(Vector1):Ofs(Vector1)] = $00000000) or
(Meml[Seg(Vector1):Ofs(Vector1)]=$F000F815) then {accomodate PCjr}
begin
writeln('Installing THELP -- Press < ALT ''H'' > to Recall help.');
writeln('');
GetIntVec(Kybdint,Vector2);
SetIntVec(UserInt,Vector2);
SetIntVec(KybdInt,@ProcessInt);
keep(exitcode);
end;
userint:=userint+1;
Until (exitcode = 3) or (UserInt > $67);
If exitcode <> 3 then writeln('User Interupts in use -- can''t install THELP.')
end.